#!c:/perl/bin/perl.exe
##########################################################################################################################
##### a script to add object permissions for Users of Wigan-Warriors.com
##########################################################################################################################

##########################################################################################################################
######  TODO list  #######################################################################################################
##########################################################################################################################
##########################################################################################################################

##########################################################################################################################
###### Bug list
##########################################################################################################################
##########################################################################################################################

##########################################################################################################################
# Includes
##########################################################################################################################

use lib qw(../cgi-bin);
use WiganRL;
use DBI;
use DBD::mysql;


use strict;
#use warnings;
local $SIG{__WARN__} = \&Carp::cluck;  #full call back trace

$|++;  #unbuffered

##########################################################################################################################
# class and database setup
##########################################################################################################################

my $cfg= WiganRL::DataObject->load_config('../cgi-bin/wiganrl.ini');
my $dbh= Diva::DB->new();
$dbh->set( {
	DATABASE_NAME       => $cfg->val('database', 'DATABASE_NAME'),
	DATABASE_SERVER     => $cfg->val('database', 'DATABASE_SERVER'),
	DATABASE_USERNAME   => $cfg->val('database', 'DATABASE_USERNAME'),
	DATABASE_PASSWORD   => $cfg->val('database', 'DATABASE_PASSWORD'),
	DATABASE_TYPE       => $cfg->val('database', 'DATABASE_TYPE'),
	} );
$dbh->connect();
$dbh->debug(0);
WiganRL::DataObject->dbh($dbh);
WiganRL::Search->dbh($dbh);
WiganRL::DataObject->init_class('WWCOM');  #loads contenttypes
WiganRL::DataObject->site_seasonid(WiganRL::DataObject::Season->getSeasonID());  #current season
WiganRL::DataObject::View->nobjs_hot($cfg->val('forums', 'NOBJS_HOT'));
WiganRL::DataObject::View->default_forum($cfg->val('forums', 'DEFAULT_FORUM'));

##########################################################################################################################
# Start algorithm
##########################################################################################################################

use Lingua::EN::Tagger;
use PDL;

my $t= Lingua::EN::Tagger->new(stem => 1, weight_noun_phrases => 0, longest_noun_phrase => 3, unknown_word_tag => '');



my $ndocs= 1000;
#get news
my $s= WiganRL::Search->new;
$s->table('NEWS');
$s->where();
my $res= $s->search($ndocs);

my %global_word_list;
for (@$res) {
	my $o= $_;
	my $text= $o->param('NEWS_BODY');
	$text=~ s/<[^>]*>//g;
#	print $text;

	my %words= $t->get_words($text);

#	map {print "$_,$words{$_}\n"} keys %words;

	map {$global_word_list{$_}+= $words{$_}} keys %words;
}

#map {print "$_,$global_word_list{$_}\n"} keys %global_word_list;

my %index;
my @keys= keys %global_word_list;
my $word_count= $#keys+1;
for (my $i= 0; $i<$word_count; $i++) {
	$index{$keys[$i]}= $i;
}

my %document_vectors;

$res= $s->search($ndocs);
for (@$res) {
	my $text= $_->param('NEWS_BODY');
	$text=~ s/<[^>]*>//g;

	$document_vectors{$_->id}= make_vector($text);
}

my $threshold= 0.1;
my $o= $s->search($ndocs+1)->[$ndocs];
my $text= $o->param('NEWS_BODY');
$text=~ s/<[^>]*>//g;

#print "Vector: ".make_vector($text)."\n";

my %cosines= get_cosines( make_vector($text) );


map {print "$_,$cosines{$_}\n"} (sort {$cosines{$b} <=> $cosines{$a}} keys %cosines);


my $id= (sort {$cosines{$b} <=> $cosines{$a}} keys %cosines)[0];
my $c= $cosines{$id};
my $o2= WiganRL::DataObject::News->new($id);
print "Word Count: $word_count\n";
#print "Doc1: \n".$o->param('NEWS_BODY')."\n\n";
#print "Doc2 $c: \n".$o2->param('NEWS_BODY')."\n\n";
#
#
#$text= "Wigan are in the Challenge Cup Final";
#$text= "Va'aiga Tuigamala";
#$text= "Andy farrell saracens";
#%cosines= get_cosines( make_vector($text) );
#my @id= sort {$cosines{$b} <=> $cosines{$a}} keys %cosines;
#map	{print "$_,$cosines{$_}\n"} (sort {$cosines{$b} <=> $cosines{$a}} keys %cosines);
#for (@id) {
#
#	$c= $cosines{$_};
#	$o2= WiganRL::DataObject::News->new($_);
#	my %words= $t->get_words( $text );
#	map {print "$_,$words{$_}\n"} keys %words;
#	print "Query: \n$text\n\n";#Vector: ".make_vector($text)."\n\n";
#	print "Doc2 $c: \n".$o2->param('NEWS_BODY')."\n\n";#."\nVector: ".$document_vectors{$o2->id}."\n\n";
#}



sub make_vector {
                my ( $doc ) = @_;
                my %words = $t->get_words( $doc );  
                my $vector = zeroes $word_count;


                foreach my $w ( keys %words ) {
                        my $value = $words{$w};
						if (exists $index{$w}) {
	                        my $offset = $index{$w};
		                    index( $vector, $offset ) .= $value;
						}
                }
                return $vector;
        }

sub cosine {
                my ($vec1, $vec2 ) = @_;
                my $n1 = norm $vec1;
                my $n2 = norm $vec2;
                my $cos = inner( $n1, $n2 );    # inner product
                return $cos->sclr();  # converts PDL object to Perl scalar
        }

     sub get_cosines {
                my ( $query_vec ) = @_;
                my %cosines;
                while ( my ( $id, $vec ) = each  %document_vectors ) {
                        my $cosine = cosine( $vec, $query_vec );
                        next unless $cosine > $threshold;
                        $cosines{$id} = $cosine;
                }
                return %cosines;
        }

1;


